home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_2 / hprpldev.tar / scrsfky.s < prev    next >
Text File  |  1991-07-12  |  2KB  |  81 lines
  1. *---------------------------------------------------------
  2.  
  3. *
  4. * Include the header file KEYDEFS.H, which defines words
  5. * like kcUpArrow at physical key numbers.
  6. *
  7. INCLUDE KEYDEFS.H
  8. *
  9. * Include the eight characters needed for binary download
  10. *
  11. ASSEMBLE
  12.     NIBASC    /HPHP48-D/
  13. RPL
  14. *
  15. * Begin the secondary
  16. *
  17. ::
  18.   RECLAIMDISP        ( *Claim the alpha display* )
  19.   ClrDA1IsStat        ( *Temporarily disable clock* )
  20. *                       ( *Try removing ClrDA1IsStat* )
  21.   ZEROZERO        ( #0 #0 )
  22.   150 150 MAKEGROB    ( #0 #0 150x150grob )
  23.   XYGROBDISP        (  )
  24. *
  25. * Draw diagonal lines.  Remember that LINEON requires
  26. * requires #x2>#x1!
  27. *
  28.   ZEROZERO        ( #x1 #y1 )
  29.   149 149        ( #x1 #y1 #x2 #y2 )
  30.   LINEON        ( *Draw line* )
  31.   ZERO 149        ( #x1 #y1 )
  32.   149 ZERO        ( #x1 #y1 #x2 #y2 )
  33.   LINEON        ( *Draw line* )
  34. *
  35. * Place text
  36. *
  37.   HARDBUFF
  38.   75 50 "SCROLLING"    ( HBgrob 75 150 "SCROLLING" )
  39.   150 CENTER$3x5    ( HBgrob )
  40.   75 100 "EXAMPLE"      ( HBgrob 75 100 "EXAMPLE" )
  41.   150 CENTER$3x5    ( HBgrob )
  42.   DROPFALSE        ( FALSE )
  43.   { LAM Exit } BIND    ( *Bind POL exit flag* )
  44.   ' DispMenu.1
  45.   ' ::            ( *Hard key handler*   )
  46.     kpNoShift #=casedrop
  47.       ::
  48.          DUP#<7 casedrpfls ( *Enable softkeys* )
  49.          kcUpArrow    ?CaseKeyDef
  50.               :: TakeOver SCROLLUP ;
  51.          kcLeftArrow  ?CaseKeyDef
  52.               :: TakeOver SCROLLLEFT ;
  53.      kcDownArrow  ?CaseKeyDef
  54.               :: TakeOver SCROLLDOWN ;
  55.          kcRightArrow ?CaseKeyDef
  56.               :: TakeOver SCROLLRIGHT ;
  57.          kcOn          ?CaseKeyDef
  58.               :: TakeOver
  59.                  TRUE ' LAM Exit STO ;
  60.          kcRightShift    #=casedrpfls
  61.          DROP 'DoBadKeyT
  62.       ;
  63.     2DROP 'DoBadKeyT
  64.   ;
  65.   TrueTrue        ( *Key control flags* )
  66.   {
  67.     { "TOP" :: TakeOver JUMPTOP ; }
  68.     { "BOT" :: TakeOver JUMPBOT ; }
  69.     { "LEFT" :: TakeOver JUMPLEFT ; }
  70.     { "RIGHT" :: TakeOver JUMPRIGHT ; }
  71.     NullMenuKey
  72.     { "QUIT" :: TakeOver TRUE ' LAM Exit STO ; }
  73.   }
  74.   ONEFALSE        ( *1st row, no suspend* )
  75.   ' LAM Exit        ( *App exit condition* )
  76.   ' ERRJMP        ( *Error handler* )
  77.   ParOuterLoop        ( *Run the ParOuterLoop* )
  78.   RECLAIMDISP        ( *Resize and clear display* )
  79.   ClrDAsOK        ( *Redraw display* )
  80. ;
  81.